Dependencies & functions

# dependencies
library(tidyverse)
library(knitr)
library(kableExtra)
library(brms)
library(parallel)
library(tidybayes)
library(bayestestR)
library(sjPlot)
library(psych)
library(rsample)
library(broom)
library(purrr)
library(IATscores)
library(lavaan)
library(semTools)
library(modelr)
library(furrr)

# set up parallel processing
future::plan(multiprocess)

# knitr options
options(knitr.kable.NA = "/")

# set seed for bootstrapping reproducibility
set.seed(42)

# create necessary folder
dir.create("models")

Exclusions & standaridization

All dependent variables (self-reported evaluations and IAT D2 scores) were standardized (by 1 SD) after exclusions and prior to analysis condition (see Lorah, 2018: https://doi.org/10.1186/s40536-018-0061-2). This was done within each level of both IV (i.e., by Source Valence condition [positive vs. negative], and by Video Content [Genuine vs. Deepfaked]). As such, the beta estimates obtained from the Bayesian models (see research questions and data analysis plans below) therefore represent standardized beta values (\(\beta\) rather than \(B\)). More importantly, the nature of this standardization makes these estimates somewhat comparable to the frequentist standardized effect size metric Cohen’s \(d\), as both are a differences in (estimated) means as a proportion of SD although they should not be treated as equivalent. Effect size magnitude here can therefore be thought of along comparable scales as Cohen’s \(d\). As such, to aid interpretability, the point estimates of effect size will be reported as \(\delta\) (delta).

# full data
data_processed <- read.csv("../data/processed/4_data_participant_level_with_hand_scoring.csv") %>%
  # include only experiment 7
  filter(experiment == 7) %>%
  # set factor levels for t test comparisons
  mutate(source_valence = fct_relevel(source_valence,
                                      "negative",
                                      "positive"),
         experiment_condition = fct_relevel(experiment_condition,
                                            "genuine",
                                            "deepfaked"),
         deepfake_detection_closed = fct_relevel(tolower(deepfake_detection_closed),
                                                 "genuine",
                                                 "deepfaked"),
         deepfake_awareness_closed = fct_relevel(deepfake_awareness_closed,
                                                 "unaware",
                                                 "aware"))

# apply exclusions
data_after_exclusions <- data_processed %>%
  filter(exclude_subject == FALSE & 
           exclude_implausible_intervention_linger == FALSE) %>%
  # standardize DVs by 1SD within each experiment and their conditions
  group_by(experiment, experiment_condition, source_valence) %>%
  mutate(mean_self_reported_evaluation = mean_self_reported_evaluation/sd(mean_self_reported_evaluation),
         IAT_D2 = IAT_D2/sd(IAT_D2),
         mean_intentions = mean_intentions/sd(mean_intentions)) %>%
  ungroup()

# item level for iat
data_iat_item_level_after_exclusions <- read_csv("../data/processed/2.4_data_iat_item_level.csv") %>%
  # exclude the same participants as above
  semi_join(rename(data_after_exclusions, subject_original = subject), by = "subject_original")

Distributions

ggplot(data_after_exclusions, aes(mean_self_reported_evaluation)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

ggplot(data_after_exclusions, aes(IAT_D2)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

ggplot(data_after_exclusions, aes(mean_intentions)) +
  geom_density() +
  facet_wrap( ~ experiment_condition + source_valence) +
  ggtitle("Standardized scores")

Demographics

Pre exclussion

data_processed %>%
  summarise(n = n(),
            excluded_n = sum(exclude_subject > 0 | exclude_implausible_intervention_linger > 0),
            excluded_percent = (excluded_n / n) *100) %>%
  mutate_if(is.numeric, round, digits = 1) %>%
  kable(align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

n	excluded_n	excluded_percent
109	29	26.6

Post exclusions

data_after_exclusions %>%
  summarise(n = n(),
            age_mean = mean(age, na.rm = TRUE),
            age_sd = sd(age, na.rm = TRUE)) %>%
  mutate_if(is.numeric, round, digits = 1) %>%
  kable(align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

n	age_mean	age_sd
80	34	11.7

data_after_exclusions %>%
  count(gender) %>%
  spread(gender, n) %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

female	male	Non-binary
55	24	1

Internal consistency

Self-reported evaluations

model_sr <- "scale =~ ratings_bad_good + ratings_dislike_like + ratings_negative_positive" 

fit_cfa_sr <- data_after_exclusions %>%
  cfa(model = model_sr, data = .) 

results_reliability_sr <- fit_cfa_sr %>%
  reliability() %>%
  as.data.frame() %>%
  rownames_to_column(var = "metric") %>%
  select(metric, estimate = scale) %>%
  filter(metric %in% c("alpha",
                       "omega2")) %>%
  mutate(metric = recode(metric,
                         "alpha" = "alpha",
                         "omega2" = "omega_t"),
         estimate = round(estimate, 3))

results_reliability_sr %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

metric	estimate
alpha	0.989
omega_t	0.989

IAT

split half

results_iat_split_half_reliability <- data_iat_item_level_after_exclusions %>%
  SplitHalf.D2(IATdata = .) %>%
  mutate(algorithm = ifelse(algorithm == "p2112", "D2", algorithm),
         splithalf = round(splithalf, 3))

## [1] "2020-12-02 19:42:19: Applying parameter P4 = dist"
## [1] "2020-12-02 19:42:19: Applying parameters P1 and P2"
## [1] "2020-12-02 19:42:19: Applying parameter P3 = dscore"
## [1] "2020-12-02 19:42:20: Applying parameters P1 and P2"
## [1] "2020-12-02 19:42:20: Applying parameter P3 = dscore"
## [1] "2020-12-02 19:42:20: IAT scores have been computed"
## [1] "2020-12-02 19:42:20: Applying parameter P4 = dist"
## [1] "2020-12-02 19:42:20: Applying parameters P1 and P2"
## [1] "2020-12-02 19:42:20: Applying parameter P3 = dscore"
## [1] "2020-12-02 19:42:20: Applying parameters P1 and P2"
## [1] "2020-12-02 19:42:20: Applying parameter P3 = dscore"
## [1] "2020-12-02 19:42:21: IAT scores have been computed"

results_iat_split_half_reliability %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

algorithm	splithalf
D2	0.82

Behavioral intentions

model_bi <- "scale =~ behavioral_intentions_share + behavioral_intentions_subscribe + behavioral_intentions_recommend" 

fit_cfa_bi <- data_after_exclusions %>%
  cfa(model = model_bi, data = .) 

results_reliability_bi <- fit_cfa_bi %>%
  reliability() %>%
  as.data.frame() %>%
  rownames_to_column(var = "metric") %>%
  select(metric, estimate = scale) %>%
  filter(metric %in% c("alpha",
                       "omega2")) %>%
  mutate(metric = recode(metric,
                         "alpha" = "alpha",
                         "omega2" = "omega_t"),
         estimate = round(estimate, 3))

results_reliability_bi %>%
  kable(knitr.kable.NA = "/", align = "c") %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

metric	estimate
alpha	0.967
omega_t	0.969

RQ1 & 2: Can online content establish first impressions towards a novel individual?; Are Deepfakes just as good as genuine online content at establishing first impressions?

Analyses employ Bayesian linear models with source_valence, experiment_condition and their interaction as IVs. This could therefore be described as akin to a Bayesian ANOVA.
DVs were standardize as noted above, and as such fitted model estimates represent standardized beta values (which due to the specifics of the standardization have comparable [but not exact] interpretation as Cohen’s d values).
Bayesian p values are also reported: these are on a similar scale to frequentist p values, but technically are 1 minus the posterior probability that the effect is greater than 0, i.e., \(1 - P(\beta>0)\).
Inspection of the posterior distributions allow us to infer that we employed weak priors placed on all parameters (normal distribution with M = 0 and SD = 10). Inspection of the chains indicated good convergence in all cases.

H1 hypotheses were tested using a Bayesian linear model to estimate a 95% Credible Interval on standardized effect size change in evaluations between Source Valence conditions. Credible Intervals whose lower bounds were > 0 were considered evidence in support of a given hypothesis.

For H2, if the lower bound of the 95% CI of the genuine condition is < the lower bound of the 90% CI of the Deepfaked condition (i.e., the difference between Source Valence conditions in each subgroups), this as considered evidence in support of the alternative hypothesis (i.e., evidence of non-inferiority in estimated means; that Deepfakes are as good as genuine content).

Sample sizes

data_after_exclusions %>%
  select(source_valence, 
         experiment_condition) %>%
  drop_na() %>%
  count(experiment_condition,
        source_valence) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	source_valence	n
genuine	negative	23
genuine	positive	19
deepfaked	negative	23
deepfaked	positive	15

Self-reported evaluations

Fit model

fit_confirmatory_selfreport <-
  brm(formula = mean_self_reported_evaluation ~ source_valence * experiment_condition,
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_confirmatory_selfreport",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence * experiment_condition 
##    Data: data_after_exclusions (Number of observations: 80) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -2.76      0.21
## source_valencepositive                                   3.47      0.32
## experiment_conditiondeepfaked                            0.18      0.30
## source_valencepositive:experiment_conditiondeepfaked     0.75      0.46
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -3.18    -2.35 1.00
## source_valencepositive                                   2.86     4.09 1.00
## experiment_conditiondeepfaked                           -0.41     0.77 1.00
## source_valencepositive:experiment_conditiondeepfaked    -0.17     1.65 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                               15714    18354
## source_valencepositive                                  14250    16637
## experiment_conditiondeepfaked                           14345    16558
## source_valencepositive:experiment_conditiondeepfaked    13175    16301
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.02      0.08     0.86     1.20 1.00    19134    17910
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport, ask = FALSE)

Check informativeness of prior

Using Gelman’s (2019) simple heuristic: For each parameter, compare the posterior sd to the prior sd. If the posterior sd for any parameter is more than 0.1 times the prior sd, then note that the prior was informative.

check_prior(fit_confirmatory_selfreport) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

# plot_model(fit_confirmatory_selfreport)
plot_model(fit_confirmatory_selfreport, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_sr <-
  bind_cols(
    select(spread_draws(fit_confirmatory_selfreport, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_confirmatory_selfreport, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_confirmatory_selfreport, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + main_experiment_condition + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results
estimates_sr <-
  map_estimate(draws_sr) %>%
  full_join(bayestestR::hdi(draws_sr, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

# results table
estimates_sr %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	3.52	2.85	4.08	2.95	3.99	0.0000000
main_experiment_condition	0.17	-0.41	0.76	-0.31	0.68	0.2702500
interaction	0.75	-0.15	1.66	0.02	1.54	0.0529286
effect_genuine	3.52	2.85	4.08	2.95	3.99	0.0000000
effect_deepfaked	4.39	3.73	5.06	3.84	4.95	0.0000000
percent_comparison	126.77	104.40	150.38	108.40	146.77	/

# hypothesis testing
H1a <- ifelse((estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1b <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2a <- ifelse((estimates_sr %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_sr %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_sr <-
  paste0("Deepfakes are ",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1),
         "% (95% CI [",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_sr %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1a

The content of the genuine videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

H1b

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

H2a

Change in self-reported evaluations (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

Result: Accepted. Deepfakes are 126.8% (95% CI [104.4, 150.4]) as effective as genuine content in establishing self-reported evaluations.

Implicit

Fit model

fit_confirmatory_implicit <-
  brm(formula = IAT_D2 ~ source_valence * experiment_condition,
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_confirmatory_implicit",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence * experiment_condition 
##    Data: data_after_exclusions (Number of observations: 80) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -0.22      0.21
## source_valencepositive                                   1.52      0.32
## experiment_conditiondeepfaked                           -0.08      0.30
## source_valencepositive:experiment_conditiondeepfaked     1.06      0.46
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -0.64     0.19 1.00
## source_valencepositive                                   0.90     2.15 1.00
## experiment_conditiondeepfaked                           -0.67     0.50 1.00
## source_valencepositive:experiment_conditiondeepfaked     0.15     1.97 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                               13653    17593
## source_valencepositive                                  12528    16666
## experiment_conditiondeepfaked                           12751    16923
## source_valencepositive:experiment_conditiondeepfaked    11306    14880
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.02      0.08     0.87     1.20 1.00    19862    18413
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit)
plot_model(fit_confirmatory_implicit, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_imp <-
  bind_cols(
    select(spread_draws(fit_confirmatory_implicit, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_confirmatory_implicit, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_confirmatory_implicit, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + main_experiment_condition + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results table
estimates_imp <-
  map_estimate(draws_imp) %>%
  full_join(bayestestR::hdi(draws_imp, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

estimates_imp %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	1.49	0.88	2.13	1.00	2.03	0.0000000
main_experiment_condition	-0.05	-0.68	0.49	-0.56	0.41	0.3903571
interaction	1.09	0.14	1.96	0.27	1.79	0.0113571
effect_genuine	1.49	0.88	2.13	1.00	2.03	0.0000000
effect_deepfaked	2.54	1.84	3.17	1.94	3.05	0.0000000
percent_comparison	157.60	107.23	242.84	115.68	224.02	/

# hypothesis testing
H1c <- ifelse((estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1d <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2b <- ifelse((estimates_imp %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_imp %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_imp <-
  paste0("Deepfakes are ",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1), 
         "% (95% CI [",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_imp %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1c

The content of the genuine videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

Result: Accepted

H1d

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ IAT D2 scores.

Result: Accepted

H2b

Change in IAT D2 scores (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

Result: Accepted. Deepfakes are 157.6% (95% CI [107.2, 242.8]) as effective as genuine content in establishing self-reported evaluations.

Behavioural intentions

Fit model

fit_confirmatory_intentions <-
  brm(formula = mean_intentions ~ source_valence * experiment_condition, # no random effect for experiment as only exp 6 assessed intentions
      family = gaussian(),
      data    = data_after_exclusions,
      file    = "models/fit_confirmatory_intentions",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence * experiment_condition 
##    Data: data_after_exclusions (Number of observations: 80) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                                                      Estimate Est.Error
## Intercept                                               -8.63      0.21
## source_valencepositive                                   6.55      0.32
## experiment_conditiondeepfaked                           -1.41      0.30
## source_valencepositive:experiment_conditiondeepfaked     1.19      0.46
##                                                      l-95% CI u-95% CI Rhat
## Intercept                                               -9.04    -8.21 1.00
## source_valencepositive                                   5.93     7.17 1.00
## experiment_conditiondeepfaked                           -2.01    -0.83 1.00
## source_valencepositive:experiment_conditiondeepfaked     0.29     2.10 1.00
##                                                      Bulk_ESS Tail_ESS
## Intercept                                               15059    19074
## source_valencepositive                                  12895    15947
## experiment_conditiondeepfaked                           13294    17359
## source_valencepositive:experiment_conditiondeepfaked    11029    16032
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.02      0.08     0.87     1.19 1.00    20240    19180
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative
b_experiment_conditiondeepfaked	uninformative
b_source_valencepositive.experiment_conditiondeepfaked	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions)
plot_model(fit_confirmatory_intentions, type = "pred", terms = c("source_valence", "experiment_condition"))

# percent moderation
draws_intentions <-
  bind_cols(
    select(spread_draws(fit_confirmatory_intentions, b_source_valencepositive), b_source_valencepositive),
    select(spread_draws(fit_confirmatory_intentions, b_experiment_conditiondeepfaked), b_experiment_conditiondeepfaked),
    select(spread_draws(fit_confirmatory_intentions, `b_source_valencepositive:experiment_conditiondeepfaked`), `b_source_valencepositive:experiment_conditiondeepfaked`)
  ) %>%
  rename(main_valence = b_source_valencepositive,
         main_experiment_condition = b_experiment_conditiondeepfaked,
         interaction = `b_source_valencepositive:experiment_conditiondeepfaked`) %>%
  mutate(effect_genuine = main_valence,
         effect_deepfaked = main_valence + main_experiment_condition + interaction,
         #percent_moderation = (main_experiment_condition + interaction)/main_valence *100,  # alt method, same result
         percent_comparison = (effect_deepfaked/effect_genuine)*100)

# results table
estimates_intentions <-
  map_estimate(draws_intentions) %>%
  full_join(bayestestR::hdi(draws_intentions, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions %>%
              select(-percent_comparison) %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper,
         CI_90_lower, CI_90_upper, p)

estimates_intentions %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
main_valence	6.55	5.92	7.17	6.02	7.07	0.00000
main_experiment_condition	-1.44	-1.98	-0.80	-1.91	-0.92	0.00000
interaction	1.18	0.28	2.09	0.42	1.93	0.00475
effect_genuine	6.55	5.92	7.17	6.02	7.07	0.00000
effect_deepfaked	6.37	5.67	7.00	5.76	6.87	0.00000
percent_comparison	95.88	86.40	107.22	88.04	105.49	/

# hypothesis testing
H1e <- ifelse((estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H1f <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H2c <- ifelse((estimates_intentions %>% filter(Parameter == "effect_deepfaked") %>% pull(CI_90_lower)) > 
                (estimates_intentions %>% filter(Parameter == "effect_genuine") %>% pull(CI_95_lower)), 
              "Accepted", "Rejected")

comparison_string_intentions <-
  paste0("Deepfakes are ",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(MAP_Estimate) %>% round(1), 
         "% (95% CI [",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_lower) %>% round(1),
         ", ",
         estimates_intentions %>% filter(Parameter == "percent_comparison") %>% pull(CI_95_upper) %>% round(1),
         "]) as effective as genuine content in establishing self-reported evaluations")

H1e

The content of the genuine videos (i.e., Source Valence) will influence participants’ behavioral intention responses.

Result: Accepted

H1f

The content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention responses.

Result: Accepted

H2c

Change in behavioral intentions (i.e., between Source Valence conditions) induced by Deepfaked video content will be non-inferior to genuine content.

Result: Rejected. Deepfakes are 95.9% (95% CI [86.4, 107.2]) as effective as genuine content in establishing self-reported evaluations.

RQ3: How good are people at detecting Deepfakes?

Can people accurately detect deepfakes?

Youden’s J = sensitivity + specificity - 1, aka informedness, aka “the probability of an informed decision (as opposed to a random guess) and takes into account all predictions”
95% CIs were bootstrapped via case removal and the percentile method.

Sample size

data_after_exclusions %>%
  count(experiment_condition,
        deepfake_detection_closed) %>%
  drop_na() %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	deepfake_detection_closed	n
genuine	genuine	26
genuine	deepfaked	16
deepfaked	genuine	19
deepfaked	deepfaked	19

Classification stats

data_counts <- data_after_exclusions %>%
  select(experiment_condition, deepfake_detection_closed) %>%
  drop_na() %>%
  count(experiment_condition, deepfake_detection_closed)

TP <- pull(filter(data_counts, experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked"),  n)
FP <- pull(filter(data_counts, experiment_condition == "genuine"   & deepfake_detection_closed == "deepfaked"),  n)
FN <- pull(filter(data_counts, experiment_condition == "deepfaked" & deepfake_detection_closed == "genuine"), n)
TN <- pull(filter(data_counts, experiment_condition == "genuine"   & deepfake_detection_closed == "genuine"), n)

sensitivity         <- TP / (TP+FN)
false_negative_rate <- 1 - sensitivity
specificity         <- TN / (TN+FP)
false_positive_rate <- 1 - specificity

# Youden's J statistic aka informedness aka "the probability of an informed decision (as opposed to a random guess) and takes into account all predictions". a zero value when a diagnostic test gives the same proportion of positive results for groups with and without the disease, i.e the test is useless.
informedness <- sensitivity + specificity - 1

balanced_accuracy <- (sensitivity + specificity)/2

fit_confirmatory_classification <-
  tibble(variable = c(
    "balanced_accuracy",
    "informedness",
    #"sensitivity",
    "false_negative_rate",
    #"specificity",
    "false_positive_rate"
  ),
  observed = c(
    balanced_accuracy,
    informedness,
    #sensitivity,
    false_negative_rate,
    #specificity,
    false_positive_rate
  ))

Bootstrapped classification stats

if(file.exists("models/fit_confirmatory_classification_bootstraps.rds")){

  fit_confirmatory_classification_bootstraps <- read_rds("models/fit_confirmatory_classification_bootstraps.rds")

} else {

  # create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
  boots <- data_after_exclusions %>%
    select(experiment_condition, deepfake_detection_closed) %>%
    drop_na() %>%
    bootstraps(times = 2000)

  # generalize to a summarize function ------
  bootstrap_categorization_stats <- function(split) {

    data_counts <- analysis(split) %>%
      count(experiment_condition, deepfake_detection_closed)

    TP <- pull(filter(data_counts, experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked"),  n)
    FP <- pull(filter(data_counts, experiment_condition == "genuine"   & deepfake_detection_closed == "deepfaked"),  n)
    FN <- pull(filter(data_counts, experiment_condition == "deepfaked" & deepfake_detection_closed == "genuine"), n)
    TN <- pull(filter(data_counts, experiment_condition == "genuine"   & deepfake_detection_closed == "genuine"), n)

    #accuracy <- (TP+TN)/(TP+TN+FP+FN)
    sensitivity <- TP / (TP+FN)
    false_negative_rate <- 1 - sensitivity
    specificity <- TN / (TN+FP)
    false_positive_rate <- 1 - specificity

    # Youden's J statistic aka informedness aka "the probability of an informed decision (as opposed to a random guess) and takes into account all predictions". a zero value when a diagnostic test gives the same proportion of positive results for groups with and without the disease, i.e the test is useless.
    informedness <- sensitivity + specificity - 1

    balanced_accuracy <- (sensitivity + specificity)/2

    results <-
      tibble(variable = c(
        #"accuracy",
        "balanced_accuracy",
        "informedness",
        #"sensitivity",
        "false_negative_rate",
        #"specificity",
        "false_positive_rate"
      ),
      value = c(
        #accuracy,
        balanced_accuracy,
        informedness,
        #sensitivity,
        false_negative_rate,
        #specificity,
        false_positive_rate
      ))

    return(results)
  }

  # apply to each bootstrap
  fit_confirmatory_classification_bootstraps <- boots %>%
    mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
    select(-splits) %>%
    unnest(categorization_stats)

  write_rds(fit_confirmatory_classification_bootstraps, "models/fit_confirmatory_classification_bootstraps.rds")

}

Results

classifications <- fit_confirmatory_classification_bootstraps %>%
  group_by(variable) %>%
  summarize(ci_lower = quantile(value, 0.025),
            ci_upper = quantile(value, 0.975),
            .groups  = "drop") %>%
  full_join(fit_confirmatory_classification, by = "variable") %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  select(variable, observed, ci_lower, ci_upper) 

classifications %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.56	0.45	0.67
false_negative_rate	0.50	0.34	0.67
false_positive_rate	0.38	0.23	0.53
informedness	0.12	-0.10	0.34

H3: Participants are poor at making accurate and informed judgements about whether online video content is genuine or Deepfaked. Our predictions here are descriptive/continuous rather than involving cut-off based inference rules.

H3a

We expect participants to be poor at correctly detecting Deepfakes (i.e., demonstrate a false negative rate, FNR ≳ .80).

H3b

We expect participants to incorrectly detect Deepfakes even when the video content was real (i.e., demonstrate a false positive rate, FPR ≳ .05).

H3c

We expect participants to be poor at making accurate decisions about whether content is genuine or not (i.e., balanced accuracy not greatly above chance, ≲ .60).

H3d

We expect participants to make poorly informed decisions about whether content is genuine or not (i.e., informedness/Youden’s J ≲ .25).

Even the subset of participants who were aware of the concept of Deepfakes before the study?

Sample size

data_after_exclusions %>%
  filter(deepfake_awareness_closed == "aware") %>%
  count(experiment_condition,
        deepfake_detection_closed) %>%
  drop_na() %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

experiment_condition	deepfake_detection_closed	n
genuine	genuine	14
genuine	deepfaked	9
deepfaked	genuine	10
deepfaked	deepfaked	14

Classification stats

data_counts_subset <- data_after_exclusions %>%
  filter(deepfake_awareness_closed == "aware") %>%
  select(experiment_condition, deepfake_detection_closed) %>%
  drop_na() %>%
  count(experiment_condition, deepfake_detection_closed)

TP <- pull(filter(data_counts_subset, experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked"),  n)
FP <- pull(filter(data_counts_subset, experiment_condition == "genuine"   & deepfake_detection_closed == "deepfaked"),  n)
FN <- pull(filter(data_counts_subset, experiment_condition == "deepfaked" & deepfake_detection_closed == "genuine"), n)
TN <- pull(filter(data_counts_subset, experiment_condition == "genuine"   & deepfake_detection_closed == "genuine"), n)

sensitivity         <- TP / (TP+FN)
false_negative_rate <- 1 - sensitivity
specificity         <- TN / (TN+FP)
false_positive_rate <- 1 - specificity

# Youden's J statistic aka informedness aka "the probability of an informed decision (as opposed to a random guess) and takes into account all predictions". a zero value when a diagnostic test gives the same proportion of positive results for groups with and without the disease, i.e the test is useless.
informedness <- sensitivity + specificity - 1

balanced_accuracy <- (sensitivity + specificity)/2

fit_confirmatory_classification_subset <-
  tibble(variable = c(
    "balanced_accuracy",
    "informedness",
    #"sensitivity",
    "false_negative_rate",
    #"specificity",
    "false_positive_rate"
  ),
  observed = c(
    balanced_accuracy,
    informedness,
    #sensitivity,
    false_negative_rate,
    #specificity,
    false_positive_rate
  ))

Bootstrapped classification stats

if(file.exists("models/fit_confirmatory_classification_bootstraps_subset.rds")){

  fit_confirmatory_classification_bootstraps_subset <- read_rds("models/fit_confirmatory_classification_bootstraps_subset.rds")

} else {

  # create bootstraps using out of bag method. makes a df with values that are collapsed dfs.
  boots <- data_after_exclusions %>%
    filter(deepfake_awareness_closed == "aware") %>%
    select(experiment_condition, deepfake_detection_closed) %>%
    drop_na() %>%
    bootstraps(times = 2000)

  # generalize to a summarize function ------
  bootstrap_categorization_stats <- function(split) {

    data_counts <- analysis(split) %>%
      count(experiment_condition, deepfake_detection_closed)

    TP <- pull(filter(data_counts, experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked"),  n)
    FP <- pull(filter(data_counts, experiment_condition == "genuine"   & deepfake_detection_closed == "deepfaked"),  n)
    FN <- pull(filter(data_counts, experiment_condition == "deepfaked" & deepfake_detection_closed == "genuine"), n)
    TN <- pull(filter(data_counts, experiment_condition == "genuine"   & deepfake_detection_closed == "genuine"), n)
    
    #accuracy <- (TP+TN)/(TP+TN+FP+FN)
    sensitivity <- TP / (TP+FN)
    false_negative_rate <- 1 - sensitivity
    specificity <- TN / (TN+FP)
    false_positive_rate <- 1 - specificity

    # Youden's J statistic aka informedness aka "the probability of an informed decision (as opposed to a random guess) and takes into account all predictions". a zero value when a diagnostic test gives the same proportion of positive results for groups with and without the disease, i.e the test is useless.
    informedness <- sensitivity + specificity - 1

    balanced_accuracy <- (sensitivity + specificity)/2

    results <-
      tibble(variable = c(
        #"accuracy",
        "balanced_accuracy",
        "informedness",
        #"sensitivity",
        "false_negative_rate",
        #"specificity",
        "false_positive_rate"
      ),
      value = c(
        #accuracy,
        balanced_accuracy,
        informedness,
        #sensitivity,
        false_negative_rate,
        #specificity,
        false_positive_rate
      ))

    return(results)
  }

  # apply to each bootstrap
  fit_confirmatory_classification_bootstraps_subset <- boots %>%
    mutate(categorization_stats = future_map(splits, bootstrap_categorization_stats)) %>%
    select(-splits) %>%
    unnest(categorization_stats)

  write_rds(fit_confirmatory_classification_bootstraps_subset, "models/fit_confirmatory_classification_bootstraps_subset.rds")

}

Results

classifications_subset <- fit_confirmatory_classification_bootstraps_subset %>%
  group_by(variable) %>%
  summarize(ci_lower = quantile(value, 0.025),
            ci_upper = quantile(value, 0.975),
            .groups  = "drop") %>%
  full_join(fit_confirmatory_classification_subset, by = "variable") %>%
  mutate_if(is.numeric, round, digits = 2) %>%
  select(variable, observed, ci_lower, ci_upper) 

classifications_subset %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.60	0.46	0.73
false_negative_rate	0.42	0.21	0.62
false_positive_rate	0.39	0.20	0.59
informedness	0.19	-0.09	0.46

RQ4: Are people aware that content can be Deepfaked before they take part in the study, and does this make them better at detecting them?

Percent of participants awareness of the concept prior to study

I.e., using the full sample and reporting the sample percentage.

Description of sample:

percent_aware <- data_after_exclusions %>%
  dplyr::select(deepfake_awareness_closed) %>%
  drop_na() %>%
  count(deepfake_awareness_closed) %>%
  mutate(counts = n,
         awareness = as.factor(deepfake_awareness_closed),
         percent_aware = round(counts/sum(counts)*100, 1)) %>%
  filter(awareness == "aware") %>%
  dplyr::select(percent_aware) 

percent_aware %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

percent_aware
58.8

In the subset of participants who were shown a deepfake, did prior awareness make them more likely to detect it?

Putting aside true negatives and false positive, does prior awareness of the concept of deepfaking at least make people better at detecting deepfakes

It would of course be possible include data from both experiment_conditions and add it to the model, however interpreting the two and three way interactions is less intuitive. Given this question is of secondary importance, I we therefore elected for the simpler analysis focusing on awareness and the FNR/TPR.

Fit model

# convert data to counts
data_counts_awareness_detection <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked") %>%
  dplyr::select(experiment, deepfake_awareness_closed, deepfake_detection_closed) %>%
  drop_na() %>%
  mutate(deepfake_awareness_closed = case_when(deepfake_awareness_closed == "aware" ~ TRUE,
                                               deepfake_awareness_closed == "unaware" ~ FALSE),
         deepfake_detection_closed = case_when(deepfake_detection_closed == "deepfaked" ~ TRUE,
                                               deepfake_detection_closed == "genuine" ~ FALSE)) %>%
  count(experiment, deepfake_awareness_closed, deepfake_detection_closed) %>%
  group_by(experiment) %>%
  mutate(counts = n,
         awareness = as.factor(deepfake_awareness_closed),
         detection = as.factor(deepfake_detection_closed),
         proportion = counts/sum(counts)) %>%
  ungroup() %>%
  dplyr::select(experiment, awareness, detection, counts, proportion)

# total counts is needed later to convert to proportions
total_counts_awareness_detection <- data_counts_awareness_detection %>%
  group_by(experiment) %>%
  summarize(total = sum(counts)) %>%
  ungroup()

# fit poisson model
fit_confirmatory_poisson_awareness_detection <- 
  brm(formula = counts ~ 1 + awareness * detection,
      family  = poisson(),
      data    = data_counts_awareness_detection,
      file    = "models/fit_confirmatory_poisson_awareness_detection",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.998,
                     max_treedepth = 18),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

pp_check(fit_confirmatory_poisson_awareness_detection, nsamples = 100)

summary(fit_confirmatory_poisson_awareness_detection)

##  Family: poisson 
##   Links: mu = log 
## Formula: counts ~ 1 + awareness * detection 
##    Data: data_counts_awareness_detection (Number of observations: 4) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                             Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                       2.14      0.34     1.42     2.75 1.00    11572
## awarenessTRUE                   0.12      0.47    -0.80     1.06 1.00     9193
## detectionTRUE                  -0.62      0.58    -1.80     0.48 1.00     8363
## awarenessTRUE:detectionTRUE     0.97      0.72    -0.44     2.42 1.00     7586
##                             Tail_ESS
## Intercept                      12873
## awarenessTRUE                  11260
## detectionTRUE                  11424
## awarenessTRUE:detectionTRUE    10134
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_poisson_awareness_detection, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_poisson_awareness_detection) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_awarenessTRUE	uninformative
b_detectionTRUE	uninformative
b_awarenessTRUE.detectionTRUE	uninformative

Interpret posteriors

sjPlot doesn’t behave well with these variable names for some reason. From top to bottom, the parameters are awareness, detection, and awareness*detection.

plot_model(fit_confirmatory_poisson_awareness_detection) + xlab("Parameter")

# plot(conditional_effects(fit_confirmatory_poisson_awareness_detection), ask = FALSE)

Parameter estimates

# posterior draws for parameters (for results table)
draws_awareness_detection <- posterior_samples(fit_confirmatory_poisson_awareness_detection) %>%
  dplyr::select(awarenessTRUE = b_awarenessTRUE, 
                detectionTRUE = b_detectionTRUE, 
                interaction   = `b_awarenessTRUE:detectionTRUE`) 

estimates_awareness_detection <- 
  full_join(as_tibble(map_estimate(draws_awareness_detection)),
            as_tibble(bayestestR::hdi(draws_awareness_detection, ci = .95)), 
          by = "Parameter") %>%
  # exponentiate the log IRR values to IRR
  mutate_if(is.numeric, exp) %>%
  full_join(draws_awareness_detection %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(exp(value) > 1)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  dplyr::select(Parameter, incidence_rate_ratio_MAP = MAP_Estimate, CI_95_lower = CI_low, CI_95_upper = CI_high, p) 
  # convert from odds to probability
  # mutate_if(is.numeric, function(x){x/(1+x)}) %>%
  
# table
estimates_awareness_detection %>%
  mutate_at(vars("incidence_rate_ratio_MAP", "CI_95_lower", "CI_95_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	incidence_rate_ratio_MAP	CI_95_lower	CI_95_upper	p
awarenessTRUE	1.07	0.45	2.91	0.4070357
detectionTRUE	0.59	0.17	1.66	0.1332500
interaction	2.43	0.64	11.12	0.0847500

# hypothesis testing
H4 <- ifelse((estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower)) > 1, 
              "Accepted", "Rejected")

comparison_string_awareness_detection <-
  paste0("Individuals who were aware of the concept of Deepfakes prior to participating in the study were ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(1), 
         " times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(incidence_rate_ratio_MAP) %>% round(2), 
         ", 95% CI [",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_lower) %>% round(2),
         ", ",
         estimates_awareness_detection %>% filter(Parameter == "interaction") %>% pull(CI_95_upper) %>% round(2),
         "])")

Using the subset of participants who were in the Deepfake condition, we calculated counts for each of the combinations of the Deepfake concept check and Deepfake detection questions (e.g., awareness = TRUE & detection = TRUE, awareness = TRUE & detection = FALSE, etc.). We will then use a Bayesian Poisson model to estimate a 95% Credible Interval around the interaction effect’s Incidence Rate Ratio. A Credible Interval whose lower bound is > 1 will be considered evidence in support of this hypothesis. Estimated marginal predicted probabilities will also be reported.

Result: Rejected
Individuals who were aware of the concept of Deepfakes prior to participating in the study were 2.4 times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = 2.43, 95% CI [0.64, 11.12])

Predicted probabilities

posterior_predictions_awareness_detection <-
  tibble(experiment = 7,
         awareness = c("TRUE", "FALSE"),
         detection = c("TRUE", "FALSE")) %>%
  data_grid(experiment, awareness, detection) %>%
  add_predicted_draws(model = fit_confirmatory_poisson_awareness_detection, re_formula = NULL) %>%
  rename(predicted_count = .prediction) %>%
  left_join(total_counts_awareness_detection, by = "experiment") %>%
  mutate(predicted_probabiity = predicted_count/total) %>%
  ungroup() %>%
  dplyr::select(awareness, detection, predicted_count, predicted_probabiity) 


posterior_predictions_awareness_detection_aT_dT <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "TRUE" & detection == "TRUE")
posterior_predictions_awareness_detection_aT_dF <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "TRUE" & detection == "FALSE")
posterior_predictions_awareness_detection_aF_dT <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "FALSE" & detection == "TRUE")
posterior_predictions_awareness_detection_aF_dF <- posterior_predictions_awareness_detection %>% 
  filter(awareness == "FALSE" & detection == "FALSE")


results_detection_probabilities <- 
  rbind(
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dT$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "TRUE", detection = "TRUE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aT_dF$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "TRUE", detection = "FALSE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dT$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "FALSE", detection = "TRUE"),
    bind_cols(as_tibble(map_estimate(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity)),
              as_tibble(bayestestR::hdi(posterior_predictions_awareness_detection_aF_dF$predicted_probabiity, 
                                        ci = .95))) %>%
      mutate(awareness = "FALSE", detection = "FALSE")
  ) %>%
  dplyr::select(awareness, detection, detection_probability_MAP = value, 
                CI_95_lower = CI_low, CI_95_upper = CI_high) %>%
  mutate_if(is.numeric, round, digits = 3) 

results_detection_probabilities %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

awareness	detection	detection_probability_MAP	CI_95_lower	CI_95_upper
TRUE	TRUE	0.342	0.105	0.632
TRUE	FALSE	0.237	0.079	0.500
FALSE	TRUE	0.079	0.000	0.289
FALSE	FALSE	0.158	0.053	0.447

Probability of detecting deepfake if unaware: 0.079
Probability of detecting deepfake if aware: 0.342

RQ5: Does prior awareness of the concept of Deepfakes make people immune to their influence?

Subset who received deepfaked videos and were aware of the concept prior to the experiment. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_aware_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_awareness_closed == "aware") %>%
  count(deepfake_awareness_closed) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_aware_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_awareness_closed	n	proportion
aware	24	1

data_aware_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_awareness_closed == "aware")

Self-reported evaluations

Fit model

fit_confirmatory_selfreport_deepfaked_aware <-
  brm(formula = mean_self_reported_evaluation ~ source_valence,
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_confirmatory_selfreport_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence 
##    Data: data_aware_subset (Number of observations: 24) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -2.57      0.24    -3.04    -2.09 1.00    19717
## source_valencepositive     4.38      0.39     3.60     5.16 1.00    18856
##                        Tail_ESS
## Intercept                 16333
## source_valencepositive    15724
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.92      0.15     0.69     1.27 1.00    17591    16636
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport_deepfaked_aware, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_selfreport_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_selfreport_deepfaked_aware)
plot_model(fit_confirmatory_selfreport_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_aware <-
  select(spread_draws(fit_confirmatory_selfreport_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_sr_deepfaked_aware <-
  map_estimate(draws_sr_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	4.39	3.73	5.06	3.84	4.95	0
effect_deepfaked_aware	4.39	3.60	5.16	3.73	5.01	0

# hypothesis testing
H5a <- ifelse((estimates_sr_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5a

In the subset of participants who were shown a Deepfaked video and reported being aware of the concept of Deepfaking prior to participating in the experiment, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

Implicit

Fit model

fit_confirmatory_implicit_deepfaked_aware <-
  brm(formula = IAT_D2 ~ source_valence,
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_confirmatory_implicit_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence 
##    Data: data_aware_subset (Number of observations: 24) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -0.16      0.29    -0.73     0.40 1.00    17973
## source_valencepositive     2.13      0.47     1.20     3.07 1.00    18272
##                        Tail_ESS
## Intercept                 15282
## source_valencepositive    15366
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.09      0.17     0.81     1.49 1.00    16368    15489
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit_deepfaked_aware, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit_deepfaked_aware)
plot_model(fit_confirmatory_implicit_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_aware <-
  select(spread_draws(fit_confirmatory_implicit_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_imp_deepfaked_aware <-
  map_estimate(draws_imp_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.54	1.84	3.17	1.94	3.05	0.0000000
effect_deepfaked_aware	2.08	1.22	3.08	1.37	2.92	0.0001786

# hypothesis testing
H5b <- ifelse((estimates_imp_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5b

Result: Accepted

Behavioural intentions

Fit model

fit_confirmatory_intentions_deepfaked_aware <-
  brm(formula = mean_intentions ~ source_valence, 
      family  = gaussian(),
      data    = data_aware_subset,
      file    = "models/fit_confirmatory_intentions_deepfaked_aware",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions_deepfaked_aware)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_aware_subset (Number of observations: 24) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                -10.00      0.29   -10.58    -9.42 1.00    17863
## source_valencepositive     7.59      0.47     6.64     8.51 1.00    16606
##                        Tail_ESS
## Intercept                 14418
## source_valencepositive    15540
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.12      0.18     0.83     1.53 1.00    15477    15004
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions_deepfaked_aware, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions_deepfaked_aware) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions_deepfaked_aware)
plot_model(fit_confirmatory_intentions_deepfaked_aware, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_aware <-
  select(spread_draws(fit_confirmatory_intentions_deepfaked_aware, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware = b_source_valencepositive)

estimates_intentions_deepfaked_aware <-
  map_estimate(draws_intentions_deepfaked_aware) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_aware %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_aware) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	6.37	5.67	7.00	5.76	6.87	0
effect_deepfaked_aware	7.59	6.65	8.52	6.80	8.34	0

# hypothesis testing
H5c <- ifelse((estimates_intentions_deepfaked_aware %>% filter(Parameter == "effect_deepfaked_aware") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H5c

In the subset of participants who were shown a Deepfaked video and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ behavioral intention scores.

Result: Accepted

RQ6: Does detecting that one was exposed to a Deepfake make people immune to its influence?

Subset who received deepfaked videos but also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_detectors_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked") %>%
  count(deepfake_detection_closed) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_detectors_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_detection_closed	n	proportion
deepfaked	19	1

data_detectors_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & deepfake_detection_closed == "deepfaked")

Self-reported evaluations

Fit model

fit_confirmatory_selfreport_deepfaked_detected <-
  brm(formula = mean_self_reported_evaluation ~ source_valence,
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_confirmatory_selfreport_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence 
##    Data: data_detectors_subset (Number of observations: 19) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -2.64      0.25    -3.14    -2.14 1.00    18362
## source_valencepositive     3.82      0.49     2.85     4.78 1.00    17998
##                        Tail_ESS
## Intercept                 15547
## source_valencepositive    14972
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.92      0.17     0.65     1.32 1.00    15247    14625
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport_deepfaked_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_selfreport_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_selfreport_deepfaked_detected)
plot_model(fit_confirmatory_selfreport_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_detected <-
  select(spread_draws(fit_confirmatory_selfreport_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_sr_deepfaked_detected <-
  map_estimate(draws_sr_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	4.39	3.73	5.06	3.84	4.95	0
effect_deepfaked_detected	3.80	2.83	4.76	3.05	4.63	0

# hypothesis testing
H6a <- ifelse((estimates_sr_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6a

Result: Accepted

Implicit

Fit model

fit_confirmatory_implicit_deepfaked_detected <-
  brm(formula = IAT_D2 ~ source_valence,
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_confirmatory_implicit_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence 
##    Data: data_detectors_subset (Number of observations: 19) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -0.38      0.28    -0.93     0.17 1.00    17365
## source_valencepositive     2.66      0.54     1.59     3.75 1.00    17246
##                        Tail_ESS
## Intercept                 15284
## source_valencepositive    14229
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.02      0.19     0.73     1.48 1.00    15055    15088
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit_deepfaked_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit_deepfaked_detected)
plot_model(fit_confirmatory_implicit_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_detected <-
  select(spread_draws(fit_confirmatory_implicit_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_imp_deepfaked_detected <-
  map_estimate(draws_imp_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.54	1.84	3.17	1.94	3.05	0
effect_deepfaked_detected	2.68	1.61	3.78	1.75	3.53	0

# hypothesis testing
H6b <- ifelse((estimates_imp_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6b

Result: Accepted

Behavioural intentions

Fit model

fit_confirmatory_intentions_deepfaked_detected <-
  brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
      family  = gaussian(),
      data    = data_detectors_subset,
      file    = "models/fit_confirmatory_intentions_deepfaked_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions_deepfaked_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_detectors_subset (Number of observations: 19) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                -10.21      0.22   -10.65    -9.76 1.00    17509
## source_valencepositive     7.28      0.44     6.42     8.16 1.00    16576
##                        Tail_ESS
## Intercept                 15233
## source_valencepositive    14889
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.83      0.15     0.59     1.19 1.00    14351    14787
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions_deepfaked_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions_deepfaked_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions_deepfaked_detected)
plot_model(fit_confirmatory_intentions_deepfaked_detected, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_detected <-
  select(spread_draws(fit_confirmatory_intentions_deepfaked_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_detected = b_source_valencepositive)

estimates_intentions_deepfaked_detected <-
  map_estimate(draws_intentions_deepfaked_detected) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	6.37	5.67	7.00	5.76	6.87	0
effect_deepfaked_detected	7.29	6.46	8.19	6.54	7.97	0

# hypothesis testing
H6c <- ifelse((estimates_intentions_deepfaked_detected %>% filter(Parameter == "effect_deepfaked_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H6c

Result: Accepted

RQ7: Does being both aware of the concept of Deepfaking before the study and correcting detecting that content is Deepfaked make you immune to its influence?

Subset who received deepfaked videos, were aware of the concept before the study, and also detected them. Same Bayesian multilevel models as employed above, using only source_valence as IV, i.e., to detect whether learning effects are credibly non-zero in this subset.

Sample sizes

data_aware_detectors_subset_n <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & 
           deepfake_detection_closed == "deepfaked" & 
           deepfake_awareness_closed == "aware") %>%
  count(deepfake_detection_closed, deepfake_awareness_closed) %>%
  mutate(proportion = round(n/sum(n), 2)) %>%
  arrange(desc(proportion))

data_aware_detectors_subset_n %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

deepfake_detection_closed	deepfake_awareness_closed	n	proportion
deepfaked	aware	14	1

data_aware_detectors_subset <- data_after_exclusions %>%
  filter(experiment_condition == "deepfaked" & 
           deepfake_detection_closed == "deepfaked" & 
           deepfake_awareness_closed == "aware")

Self-reported evaluations

Fit model

fit_confirmatory_selfreport_deepfaked_aware_detected <-
  brm(formula = mean_self_reported_evaluation ~ source_valence,
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_confirmatory_selfreport_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_selfreport_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_self_reported_evaluation ~ source_valence 
##    Data: data_aware_detectors_subset (Number of observations: 14) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -2.59      0.29    -3.15    -2.01 1.00    17205
## source_valencepositive     4.07      0.54     2.99     5.15 1.00    17715
##                        Tail_ESS
## Intercept                 14345
## source_valencepositive    15100
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.91      0.21     0.60     1.41 1.00    14924    15008
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_selfreport_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_selfreport_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_selfreport_deepfaked_aware_detected)
plot_model(fit_confirmatory_selfreport_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_sr_deepfaked_aware_detected <-
  select(spread_draws(fit_confirmatory_selfreport_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_sr_deepfaked_aware_detected <-
  map_estimate(draws_sr_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_sr_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_sr_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_sr, Parameter %in% c("effect_deepfaked")),
          estimates_sr_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	4.39	3.73	5.06	3.84	4.95	0
effect_deepfaked_aware_detected	4.03	3.00	5.15	3.18	4.94	0

# hypothesis testing
H7a <- ifelse((estimates_sr_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7a

In the subset of participants who were shown a Deepfaked video, reported being aware of the concept of Deepfakes, and accurately detected that the video was Deepfaked, the content of the Deepfaked videos (i.e., Source Valence) will influence participants’ self-reported evaluations.

Result: Accepted

Implicit

Fit model

fit_confirmatory_implicit_deepfaked_aware_detected <-
  brm(formula = IAT_D2 ~ source_valence,
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_confirmatory_implicit_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_implicit_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: IAT_D2 ~ source_valence 
##    Data: data_aware_detectors_subset (Number of observations: 14) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                 -0.25      0.37    -0.99     0.48 1.00    16931
## source_valencepositive     2.68      0.69     1.32     4.05 1.00    17773
##                        Tail_ESS
## Intercept                 13781
## source_valencepositive    14620
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     1.15      0.26     0.76     1.78 1.00    14034    14120
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_implicit_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_implicit_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_implicit_deepfaked_aware_detected)
plot_model(fit_confirmatory_implicit_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_imp_deepfaked_aware_detected <-
  select(spread_draws(fit_confirmatory_implicit_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_imp_deepfaked_aware_detected <-
  map_estimate(draws_imp_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_imp_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_imp_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p) 

bind_rows(filter(estimates_imp, Parameter %in% c("effect_deepfaked")),
          estimates_imp_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	2.54	1.84	3.17	1.94	3.05	0.0000000
effect_deepfaked_aware_detected	2.69	1.35	4.08	1.53	3.77	0.0007143

# hypothesis testing
H7b <- ifelse((estimates_imp_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7b

Result: Accepted

Behavioural intentions

Fit model

fit_confirmatory_intentions_deepfaked_aware_detected <-
  brm(formula = mean_intentions ~ source_valence, # no random effect for experiment as only exp 6 assessed intentions
      family  = gaussian(),
      data    = data_aware_detectors_subset,
      file    = "models/fit_confirmatory_intentions_deepfaked_aware_detected",
      prior   = prior(normal(0, 10)),
      iter    = 10000,
      warmup  = 3000,
      control = list(adapt_delta = 0.99),  # to avoid divergent transitions
      chains  = 4,
      cores   = parallel::detectCores())

Inspect convergence

summary(fit_confirmatory_intentions_deepfaked_aware_detected)

##  Family: gaussian 
##   Links: mu = identity; sigma = identity 
## Formula: mean_intentions ~ source_valence 
##    Data: data_aware_detectors_subset (Number of observations: 14) 
## Samples: 4 chains, each with iter = 10000; warmup = 3000; thin = 1;
##          total post-warmup samples = 28000
## 
## Population-Level Effects: 
##                        Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS
## Intercept                -10.23      0.28   -10.79    -9.68 1.00    15870
## source_valencepositive     7.46      0.52     6.41     8.50 1.00    16188
##                        Tail_ESS
## Intercept                 14138
## source_valencepositive    14361
## 
## Family Specific Parameters: 
##       Estimate Est.Error l-95% CI u-95% CI Rhat Bulk_ESS Tail_ESS
## sigma     0.86      0.20     0.57     1.35 1.00    13364    13578
## 
## Samples were drawn using sampling(NUTS). For each parameter, Bulk_ESS
## and Tail_ESS are effective sample size measures, and Rhat is the potential
## scale reduction factor on split chains (at convergence, Rhat = 1).

plot(fit_confirmatory_intentions_deepfaked_aware_detected, ask = FALSE)

Check informativeness of prior

check_prior(fit_confirmatory_intentions_deepfaked_aware_detected) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	Prior_Quality
b_Intercept	uninformative
b_source_valencepositive	uninformative

Interpret posteriors

#plot_model(fit_confirmatory_intentions_deepfaked_aware_detected)
plot_model(fit_confirmatory_intentions_deepfaked_aware_detected, type = "pred", terms = "source_valence")

# results table
draws_intentions_deepfaked_aware_detected <-
  select(spread_draws(fit_confirmatory_intentions_deepfaked_aware_detected, b_source_valencepositive), b_source_valencepositive) %>%
  rename(effect_deepfaked_aware_detected = b_source_valencepositive)

estimates_intentions_deepfaked_aware_detected <-
  map_estimate(draws_intentions_deepfaked_aware_detected) %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .95) %>%
              rename(CI_95_lower = CI_low,
                     CI_95_upper = CI_high) %>%
              as_tibble(),
            by = "Parameter") %>%
  full_join(bayestestR::hdi(draws_intentions_deepfaked_aware_detected, ci = .90) %>%
              as_tibble() %>%
              rename(CI_90_lower = CI_low,
                     CI_90_upper = CI_high),
            by = "Parameter") %>%
  full_join(draws_intentions_deepfaked_aware_detected %>%
              gather(Parameter, value) %>%
              group_by(Parameter) %>%
              summarize(pd = mean(value > 0)) %>%
              mutate(p = pd_to_p(pd, direction = "one-sided")) %>%
              ungroup() %>%
              select(Parameter, p),
            by = "Parameter") %>%
  select(Parameter, MAP_Estimate, CI_95_lower, CI_95_upper, 
         CI_90_lower, CI_90_upper, p)

bind_rows(filter(estimates_intentions, Parameter %in% c("effect_deepfaked")),
          estimates_intentions_deepfaked_aware_detected) %>%
  mutate_at(.vars = c("MAP_Estimate", "CI_95_lower", "CI_95_upper", "CI_90_lower", "CI_90_upper"), round, digits = 2) %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"), 
                full_width = FALSE)

Parameter	MAP_Estimate	CI_95_lower	CI_95_upper	CI_90_lower	CI_90_upper	p
effect_deepfaked	6.37	5.67	7.00	5.76	6.87	0
effect_deepfaked_aware_detected	7.44	6.40	8.48	6.61	8.31	0

# hypothesis testing
H7c <- ifelse((estimates_intentions_deepfaked_aware_detected %>% filter(Parameter == "effect_deepfaked_aware_detected") %>%
                 pull(CI_95_lower)) > 0, 
              "Accepted", "Rejected")

H7c

Result: Accepted

Summary of hypothesis tests

H1: Establishing first impressions via online video content

Genuine content can establish self-reported evaluations (Accepted), implicit evaluations (Accepted), and behavioural intentions (Accepted).
Deepfaked content can establish self-reported evaluations (Accepted), implicit evaluations (Accepted), and behavioural intentions (Accepted).

H2: Are deepfakes just as good as the real thing?

Deepfakes are non-inferior to genuine content on self-reported evaluations (Accepted), implicit evaluations (Accepted), and behavioural intentions (Rejected).

H3: How good are people at detecting whether content is genuine or Deepfaked?

Whole sample

classifications %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.56	0.45	0.67
false_negative_rate	0.50	0.34	0.67
false_positive_rate	0.38	0.23	0.53
informedness	0.12	-0.10	0.34

Those who were aware of the concept prior to the study

classifications_subset %>%
  kable() %>%
  kable_styling(bootstrap_options = c("striped", "hover", "condensed"),
                full_width = FALSE)

variable	observed	ci_lower	ci_upper
balanced_accuracy	0.60	0.46	0.73
false_negative_rate	0.42	0.21	0.62
false_positive_rate	0.39	0.20	0.59
informedness	0.19	-0.09	0.46

H4: Does prior awareness of the concept of Deepfakes make people better at detecting them?

Percent aware of the concept of Deepfakes: 58.8
Of those exposed to a Deepfake, Individuals who were aware of the concept of Deepfakes prior to participating in the study were 2.4 times more likely to detect that they had been shown a deepfake than those who were not aware of the concept (Incidence Rate Ratio = 2.43, 95% CI [0.64, 11.12]), Rejected.

H5-7: Does being aware of the concept, detecitng the deepfake, or both make you immune to a Deepfake?

H5: Evaluative learning effects found in the subset who were shown Deepfakes and were aware of the concept, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).
H6: Evaluative learning effects found in the subset who were shown Deepfakes and detected them, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).
H6: Evaluative learning effects found in the subset who were shown Deepfakes, were aware of the concept, and detected them, on self-reports (Accepted), implicit measure (Accepted) and behavioural intentions (Accepted).

Session Info

sessionInfo()

## R version 4.0.2 (2020-06-22)
## Platform: x86_64-apple-darwin17.0 (64-bit)
## Running under: macOS  10.16
## 
## Matrix products: default
## BLAS:   /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRblas.dylib
## LAPACK: /Library/Frameworks/R.framework/Versions/4.0/Resources/lib/libRlapack.dylib
## 
## locale:
## [1] en_IE.UTF-8/en_IE.UTF-8/en_IE.UTF-8/C/en_IE.UTF-8/en_IE.UTF-8
## 
## attached base packages:
## [1] parallel  stats     graphics  grDevices utils     datasets  methods  
## [8] base     
## 
## other attached packages:
##  [1] furrr_0.2.1      future_1.19.1    modelr_0.1.8     semTools_0.5-3  
##  [5] lavaan_0.6-7     IATscores_0.2.7  broom_0.7.2      rsample_0.0.7   
##  [9] psych_2.0.9      sjPlot_2.8.4     bayestestR_0.7.5 tidybayes_2.0.3 
## [13] brms_2.14.0      Rcpp_1.0.5       kableExtra_1.3.1 knitr_1.30      
## [17] forcats_0.5.0    stringr_1.4.0    dplyr_1.0.2      purrr_0.3.4     
## [21] readr_1.3.1      tidyr_1.1.2      tibble_3.0.4     ggplot2_3.3.2   
## [25] tidyverse_1.3.0 
## 
## loaded via a namespace (and not attached):
##   [1] tidyselect_1.1.0     lme4_1.1-25          htmlwidgets_1.5.1   
##   [4] grid_4.0.2           munsell_0.5.0        codetools_0.2-16    
##   [7] effectsize_0.4.0     statmod_1.4.34       DT_0.13             
##  [10] miniUI_0.1.1.1       withr_2.3.0          Brobdingnag_1.2-6   
##  [13] colorspace_2.0-0     highr_0.8            rstudioapi_0.13     
##  [16] stats4_4.0.2         bayesplot_1.7.2      listenv_0.8.0       
##  [19] labeling_0.4.2       huge_1.3.4.1         emmeans_1.4.6       
##  [22] rstan_2.21.2         mnormt_1.5-7         farver_2.0.3        
##  [25] bridgesampling_1.0-0 coda_0.19-3          vctrs_0.3.5         
##  [28] generics_0.0.2       TH.data_1.0-10       xfun_0.19           
##  [31] R6_2.5.0             markdown_1.1         assertthat_0.2.1    
##  [34] promises_1.1.0       scales_1.1.1         multcomp_1.4-13     
##  [37] nnet_7.3-14          gtable_0.3.0         globals_0.13.1      
##  [40] processx_3.4.4       sandwich_2.5-1       rlang_0.4.8         
##  [43] splines_4.0.2        checkmate_2.0.0      inline_0.3.16       
##  [46] yaml_2.2.1           reshape2_1.4.4       abind_1.4-5         
##  [49] d3Network_0.5.2.1    threejs_0.3.3        crosstalk_1.1.0.1   
##  [52] backports_1.1.9      httpuv_1.5.2         rsconnect_0.8.16    
##  [55] Hmisc_4.4-1          tools_4.0.2          ellipsis_0.3.1      
##  [58] RColorBrewer_1.1-2   ggridges_0.5.2       plyr_1.8.6          
##  [61] base64enc_0.1-3      ps_1.4.0             prettyunits_1.1.1   
##  [64] rpart_4.1-15         pbapply_1.4-2        zoo_1.8-8           
##  [67] qgraph_1.6.5         haven_2.3.1          cluster_2.1.0       
##  [70] fs_1.4.1             magrittr_2.0.1       data.table_1.13.2   
##  [73] colourpicker_1.0     reprex_0.3.0         mvtnorm_1.1-1       
##  [76] whisker_0.4          sjmisc_2.8.5         matrixStats_0.56.0  
##  [79] hms_0.5.3            shinyjs_1.1          mime_0.9            
##  [82] evaluate_0.14        arrayhelpers_1.1-0   xtable_1.8-4        
##  [85] shinystan_2.5.0      sjstats_0.18.0       jpeg_0.1-8.1        
##  [88] readxl_1.3.1         gridExtra_2.3        ggeffects_0.14.3    
##  [91] rstantools_2.1.1     compiler_4.0.2       V8_3.2.0            
##  [94] crayon_1.3.4         minqa_1.2.4          StanHeaders_2.21.0-6
##  [97] htmltools_0.5.0      corpcor_1.6.9        later_1.0.0         
## [100] Formula_1.2-3        RcppParallel_5.0.2   lubridate_1.7.9     
## [103] DBI_1.1.0            sjlabelled_1.1.7     dbplyr_1.4.3        
## [106] MASS_7.3-53          boot_1.3-25          Matrix_1.2-18       
## [109] cli_2.1.0            insight_0.10.0       igraph_1.2.5        
## [112] BDgraph_2.62         pkgconfig_2.0.3      foreign_0.8-80      
## [115] xml2_1.3.2           svUnit_1.0.3         pbivnorm_0.6.0      
## [118] dygraphs_1.1.1.6     webshot_0.5.2        estimability_1.3    
## [121] rvest_0.3.5          snakecase_0.11.0     callr_3.5.1         
## [124] digest_0.6.27        parameters_0.8.6     rmarkdown_2.5       
## [127] cellranger_1.1.0     htmlTable_1.13.3     curl_4.3            
## [130] shiny_1.5.0          gtools_3.8.2         rjson_0.2.20        
## [133] nloptr_1.2.2.2       glasso_1.11          lifecycle_0.2.0     
## [136] nlme_3.1-148         jsonlite_1.7.1       viridisLite_0.3.0   
## [139] fansi_0.4.1          pillar_1.4.6         lattice_0.20-41     
## [142] loo_2.3.1            fastmap_1.0.1        httr_1.4.1          
## [145] pkgbuild_1.1.0       survival_3.1-12      glue_1.4.2          
## [148] xts_0.12-0           fdrtool_1.2.15       png_0.1-7           
## [151] shinythemes_1.1.2    stringi_1.4.6        performance_0.4.6   
## [154] latticeExtra_0.6-29

Analyses

Preregistered analyses for experiment 7

Ian Hussey

02 December 2020

Dependencies & functions

Exclusions & standaridization

Distributions

Demographics

Pre exclussion

Post exclusions

Internal consistency

Self-reported evaluations

IAT

Behavioral intentions

RQ1 & 2: Can online content establish first impressions towards a novel individual?; Are Deepfakes just as good as genuine online content at establishing first impressions?

Sample sizes

Self-reported evaluations

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Implicit

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Behavioural intentions

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

RQ3: How good are people at detecting Deepfakes?

Can people accurately detect deepfakes?

Sample size

Classification stats

Bootstrapped classification stats

Results

Even the subset of participants who were aware of the concept of Deepfakes before the study?

Sample size

Classification stats

Bootstrapped classification stats

Results

RQ4: Are people aware that content can be Deepfaked before they take part in the study, and does this make them better at detecting them?

Percent of participants awareness of the concept prior to study

In the subset of participants who were shown a deepfake, did prior awareness make them more likely to detect it?

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Parameter estimates

Predicted probabilities

RQ5: Does prior awareness of the concept of Deepfakes make people immune to their influence?

Sample sizes

Self-reported evaluations

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Implicit

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Behavioural intentions

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

RQ6: Does detecting that one was exposed to a Deepfake make people immune to its influence?

Sample sizes

Self-reported evaluations

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors

Implicit

Fit model

Inspect convergence

Check informativeness of prior

Interpret posteriors